#!/usr/bin/perl
# Name: Casper CRS
# Description: Channel regulation system for IRC channels
# Author: The Llama Group
# Input: Plain
# Output: Plain
# Interpreter: Perl 5.12
# Dependencies:
#    DBI
#    DBD::mysql
#    IO::Socket
#    Digest::MD5
#    Digest::SHA
#
# " We are as goooooooooods! "
#            -Andrew
# " I can't wait to get my hands on his orbs. "
#            -Andrew

# Zippy is a poopoo head!

use strict;
use warnings;
require 5.010;
use feature qw/say switch/;
use DBI;
require DBD::mysql;
use IO::Socket;
use Digest::MD5 qw/md5_hex md5_base64/;
use Digest::SHA qw/sha256_hex/;

BEGIN { require "settings.conf"; }

my $version = 0.1;
open 'LOG', '>', 'Casper.log.txt';
select LOG;
local $| = 1;
select STDOUT;

my $default_settings = DEFAULT_THEME;

my $dbistr = "DBI:mysql:database=".DATABASE.";host=".HOST.";port=".PORT;
my $dbh = DBI->connect($dbistr,USERNAME,PASSWORD) or die("Could not connect to DB");
my $query = "SELECT * FROM settings WHERE `index`=".$default_settings;
my $sql = $dbh->prepare($query);
$sql->execute();
my $settings = $sql->fetchrow_hashref();

$sql->finish();
$dbh->disconnect();

if ($sql->rows() == 0) {
    die("Failed to load settings using query: ".$query."\n"); 
} 
else {
    if (!defined($settings->{'nick'})) { die("Malformed data returned: \$settings->{'nick'} not defined.\n"); }
    if (!defined($settings->{'autojoin'})) { die("Malformed data returned: \$settings->{'autojoin'} not defined.\n"); }
    if (!defined($settings->{'primary_color'})) { say LOG ">> Non-essential data missing: \$settings->{'primary_color'}.  Using default value.\n"; $settings->{'primary_color'} = "13,01"; }
    if (!defined($settings->{'secondary_color'})) { say LOG ">> Non-essential data missing: \$settings->{'secondary_color'}.  Using default value.\n"; $settings->{'primary_color'} = "00,01"; }
    if (!defined($settings->{'left_bracket'})) { say LOG ">> Non-essential data missing: \$settings->{'left_bracket'}.  Using default value.\n"; }
    if (!defined($settings->{'middle_bracket'})) { say LOG ">> Non-essential data missing: \$settings->{'middle_bracket'}.  Using default value.\n"; $settings->{'middle_bracket'} = " "; }
    if (!defined($settings->{'right_bracket'})) { say LOG ">> Non-essential data missing: \$settings->{'right_bracket'}.  Using default value.\n"; }
}

my $mynick = $settings->{'nick'};
my $me = $mynick;
my $mynick_index = 0;
my %ial;

my $sock = IO::Socket::INET->new(PeerAddr => 'irc.tribbia.net', PeerPort => '6667',Proto => 'tcp');
die("Could not create socket!\n$!\n\n") unless ($sock);

sock_send('login', '', $mynick);

while (my $line = <$sock>) {
    chomp $line; # FFS!!!
    $line =~ s/[\r\n]//g; # FFFS!!!!!!!!!!
    say $line;
    say LOG "<< $line";
    sock_parse($line);
}

close LOG;



sub bot_settings {
    my ($set,$new) = @_;
    given ($set) {
        when ('color') {
            if (defined($new)) {
                if ($new =~ /^(\d{1,2},\d{1,2}) ?(\d{1,2},\d{1,2})?/) {
                    $settings->{primary_color} = $1;
                    if (defined($2)) { $settings->{secondary_color} = $2 }
                }
            }
            return "$settings->{primary_color} $settings->{secondary_color}";
        }
    }
}
sub sock_parse {
	my ($line,$source,$type,$dest,$data,$nick,$user,$host,$pm) = ();
    $line = $_[0];
    $pm = 0;
    if ($line =~ /^PING :(.+)$/) { sock_send('pong', '', $1); }
    if ($line =~ /^:(.+?) (.+?) ([^ ]+) ?(.*)$/) {
        $source = $1;
        $type = $2;
        $dest = $3;
		$data = $4;
        $data =~ s/^://;
        ($nick,$user,$host) = split(/[!@]/,$source);
        if ($dest eq $me) { # Private message (user to user) switch.
			$pm = 1;
			$dest = $nick;
		}
        given ($type) {
            when ('001') {
                sock_send('join',$settings->{'autojoin'});
            }
            when ('433') {
                sock_send('nick', '', "$mynick-".++$mynick_index);
                $me = $mynick.'-'.$mynick_index;
            }
            when ('352') {
                my ($ial_chan, $ial_user, $ial_host, $ial_server, $ial_nick, $ial_flags, $ial_hops, $ial_info) = split(/ /,$data);
                ial('add',"$ial_nick!$ial_user\@$ial_host");
            }
            when ('PRIVMSG') {
                given ($data) {
                    when (/^\?respond\b/i) { sock_send('msg',$dest, "Casper $version responding."); }
                    when (/^\?quit\b/i) { sock_send('quit', '', "Quitting on command."); }
                    when (/^\?whoami\b/) { sock_send('msg',$dest, "Your nickname is $nick, your username is $user and your hostname is i_suck_ba-- I mean -- $host."); }
                    when (/^\?whoareyou\b/) { sock_send('msg', $dest, "I \002AM\002 METALUNA!"); }
					when (/^\?die\b/) { die("Dying on command.\n"); }
                    when (/^\001(\w+)/) {
                         my $ctcp = $1;
                         $data =~ s/\001//g;
                         if ($ctcp =~ /^(PING)/i) {
                             sock_send('notice',$nick, "\001PING ".time()."\001");
                         }
                         if ($ctcp =~ /^(VERSION)/i) {
                             sock_send('notice',$nick, "\001VERSION Casper-3 CRS:v".$version.":".$^O."\001");
                         }
                         if ($ctcp =~ /^(TIME)/i) {
                             sock_send('notice',$nick, "\001TIME :".localtime()."\001");
                         }
                         if ($ctcp =~ /^(FINGER)/i) {
                             sock_send('notice',$nick, "\001FINGER :Casper-3 CRS - Version ".$version."\001");
                         }
                         if ($ctcp =~ /^(SOURCE)/i) {
                             sock_send('notice',$nick, "\001SOURCE http://code.google.com/p/casper-3/\001");
                         }
                         if ($ctcp =~ /^(USERINFO)/i) {
                             sock_send('notice',$nick, "\001USERINFO :".$settings->{'nick'}."\001");
                         }
                    }
                    when (/^\?set color ?(.*)\b/) {
                        my $cols = bot_settings('color',$1);
                        sock_send('msg', $dest, "Colors: $cols.");
                    }
                    when (/^\?dumpial\b/) {
						my @ial = keys %ial;
						if (scalar @ial == 0) { say LOG "DEBUG: IAL is empty as fuck."; }
						while (my($key,$val) = each %ial) {
							say LOG "DEBUG: IAL: $key = $val";
						}
					}
					when (/^\?userid ?(.*)$/) {
						my ($user,$userid) = ();
						if ($1 ne '') { $user = $1 }
						else { $user = $nick }
						
						$userid = userid(userhost($user));
						if (defined($userid)) { sock_send('msg',$dest,"Success: User '$user' was matched to UserID '$userid'"); }
						else { sock_send('msg',$dest,"Error: User '$user' was not found in the database."); }
					}
					when (/^\?flags ?(.*)$/) {
						my ($user,$userid) = ();
						if ($1 ne '') { $user = $1 }
						else { $user = $nick }
						$userid = userid(userhost($user));
						
						if (defined($userid)) {
							my $flags = userinfo($userid,'flags',$dest);
							$flags = join(", ",@{$flags});
							if (defined($flags) and $flags ne '') { sock_send('msg',$dest,"User $userid has $flags flags."); }
							else { sock_send('msg',$dest,"User $userid has no flags."); }
						}
					}
					when (/^\?rights ?(.*)$/) {
						my ($user,$userid) = ();
						if ($1 ne '') { $user = $1 }
						else { $user = $nick }
						$userid = userid(userhost($user));
						
						if (defined($userid)) {
							my $rights = userinfo($userid,'rights',$dest);
							$rights = join(", ",@{$rights});
							if (defined($rights) and $rights ne '') { sock_send('msg',$dest,"User $userid has $rights rights."); }
							else { sock_send('msg',$dest,"User $userid has no rights."); }
						}
					}
					if (/^\?identify ?(.*) ?(.*)$/ and $pm) {
						my ($user,$userid,$password) = ();
						# We need to build a database update sub :P
					}
					if (/^\?password ?(.+)$/) {
						my $hash = password('generate',$1);
						if (defined($hash)) { sock_send('msg',$dest,"Your password was hashed into: $hash. Enjoy."); }
						else { sock_send('msg',$dest,"Error: Unable to hash your password for some ungodly reason."); }
					}
                }
            }
            when ('NICK') {
                my $newnick = $dest;
                $newnick =~ s/^://;
                $newnick =~ s/\r//g;
                if ($nick eq $mynick.'-'.$mynick_index && $newnick eq $mynick) { $mynick_index = 0; }
                if ($nick eq $mynick) { sock_send('nick', '', $mynick); }
                $me = $mynick;
                if (defined($ial{$nick})) { ial('remove',$nick); }
                ial('add',"$newnick!$user\@$host");
            }
            when ('QUIT') {
                if ($nick eq $mynick) { sock_send('nick', '', $mynick); }
                if (defined($ial{$nick})) { ial('remove',$nick); }
            }
            when ('JOIN') {
                if ($nick eq $me) { sock_send('who', '', $dest); }
                if (defined($ial{$nick})) {
                    if ($ial{$nick} ne $source) { ial('remove',$nick); }
                    else { return; }
                }
                ial('add',$source);
            }
            when ('PART') {
                if (defined($ial{$nick})) {
                    ial('remove',$nick);
                }
            }
        }
    }
}
sub sock_send {
    my ($type,$dest,$line) = @_;
    my $out;
    given ($type) {
        when ('pong') {
            $out = "PONG :$line";
        }
        when ('login') {
            $out = "USER $line * * :Casper CRS v$version\nNICK $line";
        }
        when ('join') {
            $out = "JOIN $dest";
        }
        when ('nick') {
            $out = "NICK $line";
        }
        when ('msg') {
            $out = "PRIVMSG $dest :$line";
        }
        when ('notice') {
            $out = "NOTICE $dest :$line";
        }
        when ('quit') {
            $out = "QUIT :$line";
        }
        when ('who') {
            $out = "WHO $line";
        }
    }
    say LOG ">> $out";
    say $sock "$out";
    say STDOUT "$out";
}

sub ial {
	my ($request,$item,$result) = ();
	($request,$item) = @_;
	say LOG "DEBUG: ial() received '$request' as request and '$item' as item.";

	if ($request eq 'add') {
		if ($item =~ /^((.+)!.+)$/) {
			$ial{$2} = $1;
			say LOG "** IAL updated: Added $2 ($1)";
		}
	}
	elsif ($request eq 'remove') {
		if (defined($ial{$item})) {
			say LOG "** IAL updated: Removed $item ($ial{$item})";
			delete $ial{$item}
		}
	}
	else {
	say LOG "DEBUG: ial() will attempt to search for '$item'";
		keys %ial;
		while (my($key,$val) = each %ial) {
			say LOG "DEBUG: ial() is testing '$key'";
			if ($key eq $item) { $result = $val; say LOG "DEBUG: ial() matched '$key' with '$item' and will return '$result'."; last; }
		}
		return $result;
	}
}
sub userhost {
	my ($user,$userhost,$userid) = ();
	$user = shift;
	$userhost = ial('',$user);
	if (!defined($userhost)) { $userhost = $user; }
	$userhost =~ s/^.+!//;
	return $userhost;
}
sub userid {
	# Accepts one of three inputs:
	# 1. User ID - Returns the ID if it exists. 
	# 2. Hostname - Returns the ID matched by the hostname.
	# 3. Username - Returns the ID matched by the username.
	
	my $input = shift;
	my $userid = undef;
	my $answer;
	say LOG "DEBUG: userid() received '$input' as input.";
	
	my $dbh = DBI->connect($dbistr,USERNAME,PASSWORD) or die("Could not connect to DB");
	my $query;

	given ($input) {
		when (/^([0-9]+)$/) { # User ID match
			say LOG "DEBUG: userid() will attempt to match by UID.";
			my $uid = $1;
			$query = "SELECT uid FROM users WHERE uid='".$uid."';";
		}
		when (/^(.+@.+)$/) { # Host match
			say LOG "DEBUG: userid() will attempt to match by host.";
			my $host = $1;
			$query = "SELECT uid,hostmask FROM users WHERE '".$host."' LIKE hostmask;";
		}
		default {
			say LOG "DEBUG: userid() will attempt to match by Username.";
			$query = "SELECT uid FROM users WHERE username='".$input."';";
		}
	}
	say LOG "DEBUG: userid() will query with '$query'";
	my $sql = $dbh->prepare($query);
	$sql->execute();
	my $user = $sql->fetchrow_hashref();
	
	if ($user->{uid}) { $userid = $user->{uid}; }
	else { $userid = undef; }
	
	if (!defined($userid)) { say LOG "DEBUG: userid() will return an undef."; return undef; } # Returns undef to indicate no match.
	else { say LOG "DEBUG: userid() will return $userid."; return $userid; } # Returns user ID if matched.
}
sub userinfo {
	my ($userid,$request,$channel) = @_;
	$channel = lc($channel);
	my $reply;
	# Connect to database.
	my $dbh = DBI->connect($dbistr,USERNAME,PASSWORD) or die("Could not connect to DB");
	say LOG "DEBUG: userinfo() received '$userid' as user-ID, '$request' as request and '$channel' as channel.";
	my $query = "SELECT * FROM users WHERE uid='".$userid."';";
	say LOG "DEBUG: userinfo() will query with '$query'";
	my $sql = $dbh->prepare($query);
	$sql->execute();
	
	# SQL rows.
	my %user = %{$sql->fetchrow_hashref()}; # I hate using references. Just FYI. -Alf
	foreach (keys %user) {
		print LOG "DEBUG: userinfo() $_: ";
		if (defined($user{$_})) { say LOG "$user{$_}"; }
		else { say LOG "<undef>"; }
	}
	# Flag retrieval.
	my (@flags,@global_flags,%channel_flags,@channel_flags) = ();
	if (defined($user{global_flags}) or defined($user{channel_flags})) {
		@flags = split(/,/,$user{global_flags}) if defined($user{global_flags}); # Global flags.
		say LOG "DEBUG: userinfo() Global flags: ".join(", ",@flags);
		if (defined($channel) and defined($user{channel_flags})) {
			say LOG "DEBUG: userinfo() was asked to find flags for channel $channel.";
			%channel_flags = (split(/ /,$user{channel_flags}));
			if (defined($channel_flags{$channel})) {
				@channel_flags = split(/,/,$channel_flags{$channel});
				say LOG "DEBUG: userinfo() $channel flags: ".join(", ",@channel_flags);
				push @flags, @channel_flags;
			}
			else {
				 say LOG "DEBUG: userinfo() did not find $channel in the channel flags list (".join(", ",keys %channel_flags).")."
			}
			@flags = keys %{{ map { $_ => 1 } @flags }};
			say LOG "DEBUG: userinfo() Unified flags: ".join(", ",@flags);
		}
		@flags = sort @flags;
	}
	# Rights retrieval.
	my (@rights,@global_rights,%channel_rights,@channel_rights) = ();
	if (defined($user{global_rights}) or defined($user{channel_rights})) {
		@global_rights = split(/,/,$user{global_rights}) if defined($user{global_rights});
		@rights = @global_rights;
		say LOG "DEBUG: userinfo() Global rights: ".join(", ",@rights);
		if (defined($channel) and defined($user{channel_rights})) {
			say LOG "DEBUG: userinfo() was asked to find rights for channel $channel.";
			%channel_rights = (split(/ /,$user{channel_rights}));
			if (defined($channel_rights{$channel})) {
				@channel_rights = split(/,/,$channel_rights{$channel});
				say LOG "DEBUG: userinfo() $channel rights: ".join(", ",@channel_rights);
				push @rights, @channel_rights;
			}
			else {
				 say LOG "DEBUG: userinfo() did not find $channel in the channel rights list (".join(", ",keys %channel_rights).")."
			}
			@rights = keys %{{ map { $_ => 1 } @rights }};
			say LOG "DEBUG: userinfo() Unified rights: ".join(", ",@rights);
		}
		@rights = sort @rights;
	}
	# Return result.
	given ($request) {
		when ('flags') { $reply = \@flags; }
		when ('rights') { $reply = \@rights; }
		when ('global_rights') { $reply = \@global_rights; }
		when ('channel_rights') { $reply = \@channel_rights; }
		when ('host') { $reply = $user{hostmask}; }
		when ('registered') { $reply = $user{registered}; }
		default {
			return (
						$userid,
						$user{username},
						$user{password},
						$user{group},
						$user{hostmask},
						\@global_flags,
						\@channel_flags,
						\@flags,			# Unified flags.
						\@global_rights,
						\@channel_rights,
						\@rights,			# Unified rights.
						$user{registered},
						$user{last_seen_nick},
						$user{last_seen_timestamp},
						$user{last_login_timestamp}
			)
		}
	}
	if (defined($reply)) { return $reply; }
	else { return undef; }
}
sub canyoudoit {
	# if User->Flag{Root} { $result = 1; }
	# elsif User->Flag{Locked} { $result = 0; }
	# elsif (!(Command eq 'ChangeFlags' && (Newflags =~ /RootFlag/ || OldFlags =~ /RootFlag/)) && User->Flag{Superuser}) { $result = 1; }
	# elsif User->Rights{CommandRight} { $result = 1; }
	# else { $result = 0 }
}
sub password {
	my ($request,$data) = @_;
	say LOG "DEBUG: password() received '$request' as request and '$data' as data.";
	if ($request eq 'generate') {
		
		# Hashing sequence:
		# 	password
		#	password = crypt(<password>,<crypt_salt>)
		#	password = md5_hex(<md5_salt><password><md5_salt>) * <iterations>
		#	password = md5_base64(<password>)
		#
		# Fuck crypt(). Big Guns time.
		
		my ($password,$md5_salt,$crypt_salt,$iterations) = ();

		# Connect to database.
		my $dbh = DBI->connect($dbistr,USERNAME,PASSWORD) or die("Could not connect to DB");
		my $query = "SELECT * FROM security;";
		say LOG "DEBUG: password() will query with '$query'";
		my $sql = $dbh->prepare($query);
		$sql->execute();
		
		# SQL rows.
		my %security = %{$sql->fetchrow_hashref()};
		foreach (keys %security) {
			print LOG "DEBUG: password() $_: ";
			if (defined($security{$_})) { say LOG "$security{$_}"; }
			else { say LOG "<undef>"; }
		}
		
		# Grabbing salts and iteration count.
		$md5_salt = $security{md5_salt};
		$crypt_salt = $security{crypt_salt};
		$iterations = $security{hash_iterations};
		
		say LOG "DEBUG: password() will use '$data' as plaintext.";
		$password = $data;
		$password = sha256_hex($crypt_salt.$password);
		for (1 .. $iterations) {
			$password = md5_hex($md5_salt.$password.$md5_salt);
		}
		$password = md5_base64($password);
		
		say LOG "DEBUG: password() will return the thoroughly hashed password: $password";
		return $password;
	}
}